home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
pctchnqs
/
1990
/
number4
/
utransfe.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-07-28
|
4KB
|
114 lines
(*
** File: utransfer.pas
** Purpose: Transfer TSR procedures for Turbo Pascal
** Author: (c) 1990 by Tom Swan
*)
unit utransfer;
interface
uses crt, dos;
var
transferError : Byte; { Non-zero = error }
function GetBlock( destination : pointer; maxSize : word ) : word;
function PutBlock( source : pointer; size : word; typeCode : byte ) : word;
procedure ClearBlock;
procedure Status( var bufSize : word; var typeCode, errorCode : byte );
implementation
const
TSRINT = $64; { The transfer TSR's interrupt number }
FN_GETBLOCK = 1; { Transfer function #1 (get block) }
FN_PUTBLOCK = 2; { Transfer function #2 (put block) }
FN_CLRBLOCK = 3; { Transfer function #3 (clear block) }
FN_STATUS = 4; { Transfer function #4 (status check) }
CF = $01; { Position of CF flag in registers.flags }
ZF = $40; { Position of ZF flag in registers.flags }
{- Private procedure to set or reset global error code }
procedure checkForError( flags : word );
var
bufSize : word;
typeCode : byte;
begin
if ((flags AND CF)<>0)
then Status( bufSize, typeCode, transferError )
else transferError := 0
end; { checkForError }
{- Retrieve data from TSR. Return no. of bytes transferred }
function GetBlock( destination : pointer; maxSize : word ) : word;
var
reg : registers;
begin
with reg do
begin
ah := FN_GETBLOCK; { Transfer TSR function number }
cx := maxSize; { Maximum transfer size }
es := Seg( destination^ ); { es = data segment address }
di := Ofs( destination^ ); { di = data offset address }
repeat
intr( TSRINT, reg ) { Call transfer function }
until ((flags AND ZF)=0); { i.e. until not busy }
GetBlock := cx; { Pass transfer size back }
checkForError( flags )
end { with }
end; { GetBlock }
{- Transfer block to TSR. Return no. of bytes transferred. }
function PutBlock( source : pointer; size : word; typeCode : byte ) : word;
var
reg : registers;
begin
with reg do
begin
ah := FN_PUTBLOCK; { Transfer TSR function number }
cx := size; { Transfer size }
dl := typeCode; { Optional data-type code }
ds := Seg( source^ ); { es = data segment address }
si := Ofs( source^ ); { di = data offset address }
repeat
intr( TSRINT, reg ) { Call transfer function }
until ((flags AND ZF)=0); { i.e. until not busy }
PutBlock := cx; { Pass transfer size back }
checkForError( flags )
end { with }
end; { PutBlock }
{- Erase any data stored in TSR }
procedure ClearBlock;
var
reg : registers;
begin
with reg do
begin
ah := FN_CLRBLOCK; { Transfer TSR function number }
repeat
intr( TSRINT, reg ) { Call transfer function }
until ((flags AND ZF)=0); { i.e. until not busy }
checkForError( flags )
end { with }
end; { ClearBlock }
{- Get status information from TSR. }
procedure Status( var bufSize : word; var typeCode, errorCode : byte );
var
reg : registers;
begin
with reg do
begin
ah := FN_STATUS; { Transfer TSR function number }
intr( TSRINT, reg ); { Call transfer function }
bufSize := cx; { Pass buffer size back }
typeCode := dl; { Pass data-type code back }
errorCode := dh { Pass error code back }
end { with }
end; { Status }
end. { utransfer }